home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-01 / toolpa.zip / JTOOLS.PAS < prev    next >
Pascal/Delphi Source File  |  1992-04-22  |  10KB  |  322 lines
  1. {*-----------------------------------------------------------------
  2.  * jtools.pas - Tool Bar Unit                                                     
  3.  * 4/22/92 - 6:28:33pm                                                                     
  4.  * John Doe                                                                                 
  5.  *-----------------------------------------------------------------}
  6. unit JTools;
  7. interface
  8. uses WinTypes, WinProcs, WObjects, Strings;
  9.  
  10. const
  11.         maxtools = 50;        { max number of tools - can be increased }
  12.  
  13. type
  14.   PToolItem = ^TToolItem;
  15.   TToolItem = object
  16.       nID : Integer;
  17.       hBitmap1, hBitmap2 : HBITMAP;
  18.       bState, bButton, bBorder, bShadow, bEnabled : Boolean;
  19.       rect : TRect;
  20.     constructor Init(AParent: PWindowsObject; pType: PChar; id, X, Y, W, H : Integer;
  21.             pBitmap1, pBitmap2, Shadow, Border : PChar);
  22.     destructor Done;
  23.       procedure Show(PaintDC : hDC; hButtonBrush : HBRUSH; hShadowPen : HPEN);
  24.       procedure SetState(bNewState : Boolean);
  25.       function GetState: Boolean;
  26.       procedure Enable(bFlag : Boolean);
  27.       function HitTest(nX, nY : Integer): Boolean;
  28.       function GetID: Integer;
  29.     end;
  30.  
  31.  
  32. type
  33.   PToolBar = ^TToolBar;
  34.   TToolBar = object(TWindow)
  35.   
  36.         hShadowPen : HPEN;
  37.       hButtonBrush : HBRUSH;
  38.       bButtonDown : Boolean;
  39.       SelToolItem, NumTools : Integer;
  40.         ToolItems : array[0..maxtools] of PToolItem;
  41.  
  42.     constructor Init(AParent: PWindowsObject; nHeight : Integer);
  43.     destructor Done;virtual;
  44.     procedure GetWindowClass(var AWndClass: TWndClass);virtual;
  45.     function GetClassName: PChar;virtual;
  46.     procedure AddToolItem(AParent: PWindowsObject; pType: PChar; id, X, Y, W, H : Integer;
  47.             pBitmap1, pBitmap2, Shadow, Border : PChar);
  48.       procedure SetItemState(ID : Integer; bState : Boolean);
  49.       procedure Paint(DC : hDC; var PS : TPaintStruct);virtual;
  50.     procedure WMLButtonDown(var Msg: TMessage);
  51.       virtual wm_First + wm_LButtonDown;
  52.     procedure WMLButtonUp(var Msg: TMessage);
  53.       virtual wm_First + wm_LButtonUp;
  54.     procedure WMMouseMove(var Msg: TMessage);
  55.       virtual wm_First + wm_MouseMove;
  56.   end;
  57.  
  58. implementation
  59.  
  60. constructor TToolItem.Init(AParent: PWindowsObject; pType: PChar; id, X, Y, W, H : Integer;
  61.             pBitmap1, pBitmap2, Shadow, Border : PChar);
  62. begin
  63.     nID := id;
  64.     hBitmap1 := LoadBitmap(HInstance, pBitmap1);
  65.     hBitmap2 := LoadBitmap(HInstance, pBitmap2);
  66.  
  67.     rect.left := X;
  68.     rect.top := Y;
  69.     rect.right := X + W;
  70.     rect.bottom := Y + H;
  71.     bState := False;
  72.     bEnabled := True;
  73.  
  74.     if Shadow^ = 'Y' then    bShadow := True else bShadow := False;
  75.  
  76.     if Border^ = 'Y' then bBorder := True else bBorder := False;
  77.  
  78.     if StrIComp(pType, 'Button') = 0 then bButton := True else    bButton := False;
  79. end;
  80.  
  81. destructor TToolItem.Done;
  82. begin
  83.     if hBitmap1 > 0 then DeleteObject(hBitmap1);
  84.     if hBitmap2 > 0 then DeleteObject(hBitmap2);
  85. end;
  86.  
  87. function TToolItem.GetID: Integer;
  88. begin GetID := nID; end;
  89.  
  90. procedure TToolItem.Show(PaintDC : hDC; hButtonBrush : HBRUSH; hShadowPen : HPEN);
  91. var    MemoryDC : HDC;
  92.         OldBitmapHandle : WORD;
  93.         dwMode : Longint;
  94.     hOldPen : HPEN;
  95.     hOldBrush : HBRUSH;
  96.     nOffset, nShift : Integer;
  97. begin
  98.  
  99.  
  100.     hOldPen := SelectObject(PaintDC, GetStockObject(BLACK_PEN));
  101.     hOldBrush := SelectObject(PaintDC, hButtonBrush);
  102.  
  103.     nOffset := 0; nShift := 0;
  104.  
  105.     if bBorder then nOffset := nOffset+1;
  106.   if bShadow then nOffset := nOffset+1;
  107.     if bState and bShadow then    nShift:=1;
  108.   if bEnabled then dwMode := SRCCOPY else dwMode := MERGECOPY;
  109.  
  110.     if bBorder then Rectangle(PaintDC, rect.left, rect.top, rect.right, rect.bottom)
  111.         else FillRect(PaintDC, rect, hButtonBrush);
  112.  
  113.     if  hBitmap1 = 0 then exit;
  114.  
  115.     MemoryDC := CreateCompatibleDC(PaintDC);
  116.     if bState and (hBitmap2 > 0) then OldBitmapHandle := SelectObject(MemoryDC, hBitmap2)
  117.        else  OldBitmapHandle := SelectObject(MemoryDC, hBitmap1);
  118.  
  119.     BitBlt(PaintDC, rect.left+nOffset+nShift, rect.top+nOffset+nShift, rect.right-rect.left, rect.bottom-rect.top,
  120.             MemoryDC, 0, 0, dwMode);
  121.  
  122.     SelectObject(MemoryDC, OldBitmapHandle);
  123.     DeleteDC(MemoryDC);
  124.  
  125.     if bShadow then
  126.        begin
  127.             if bState then SelectObject(PaintDC, hShadowPen)
  128.              else SelectObject(PaintDC, GetStockObject(WHITE_PEN));
  129.  
  130.              MoveTo(PaintDC, rect.left+nOffset-1, rect.bottom-nOffset);
  131.              LineTo(PaintDC, rect.left+nOffset-1, rect.top+nOffset-1);
  132.              LineTo(PaintDC, rect.right-nOffset+1, rect.top+nOffset-1);
  133.  
  134.             if bState = False then
  135.           begin
  136.                      SelectObject(PaintDC, hShadowPen);
  137.                      MoveTo(PaintDC, rect.right-nOffset, rect.top+nOffset-1);
  138.                      LineTo(PaintDC, rect.right-nOffset, rect.bottom-nOffset);
  139.                      LineTo(PaintDC, rect.left+nOffset-2, rect.bottom-nOffset);
  140.                      MoveTo(PaintDC, rect.right-nOffset-1, rect.top+nOffset);
  141.                      LineTo(PaintDC, rect.right-nOffset-1, rect.bottom-nOffset-1);
  142.                      LineTo(PaintDC, rect.left+nOffset-1, rect.bottom-nOffset-1);
  143.           end;
  144.       end;
  145.  
  146.     SelectObject(PaintDC, hOldPen);
  147.     SelectObject(PaintDC, hOldBrush);
  148. end;
  149.  
  150. function TToolItem.HitTest(nX,nY : Integer): Boolean;
  151. var pt : TPOINT;
  152. begin
  153.    pt.x := nX; pt.y := nY;
  154.     if not bEnabled then begin HitTest := False; exit; end;
  155.     HitTest := PtInRect(rect, pt);
  156. end;
  157. function TToolItem.GetState: Boolean;
  158. begin
  159.      GetState := bState;
  160. end;
  161. procedure TToolItem.SetState(bNewState : Boolean);
  162. begin
  163.     bState := bNewState;
  164. end;
  165. procedure TToolItem.Enable(bFlag : Boolean);
  166. begin
  167.     bEnabled := bFlag;
  168. end;
  169.  
  170. constructor TToolBar.Init(AParent: PWindowsObject; nHeight : Integer);
  171. begin
  172.   TWindow.Init(AParent, '');
  173.     bButtonDown := False;
  174.     hShadowPen := CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNSHADOW));
  175.     hButtonBrush := GetStockObject(LTGRAY_BRUSH);
  176.     SelToolItem := -1;    { No tool selected }
  177.     NumTools := 0;            { Incremented when tools are added }
  178.     Attr.X := 0;
  179.     Attr.Y := 0;
  180.     Attr.W := GetSystemMetrics(SM_CXSCREEN);     { Default to largest possible }
  181.     Attr.H := nHeight;
  182.     Attr.Style := WS_CHILD or WS_VISIBLE;
  183. end;
  184.  
  185. destructor TToolBar.Done;
  186. var i : Integer;
  187. begin
  188.     DeleteObject(hShadowPen);
  189.     for i := 0 to NumTools-1 do        { Clean up tools}
  190.         ToolItems[i]^.Done;
  191. end;
  192.  
  193. function TToolBar.GetClassName: PChar;
  194. begin
  195.   GetClassName := 'ToolBar';
  196. end;
  197.  
  198. procedure TToolBar.GetWindowClass(var AWndClass: TWndClass);
  199. begin
  200.   TWindow.GetWindowClass(AWndClass); { Get the default class }
  201.     AWndClass.hbrBackground := hButtonBrush;
  202. end;
  203.  
  204. procedure TToolBar.AddToolItem(AParent: PWindowsObject; pType: PChar; id, X, Y, W, H : Integer;
  205.             pBitmap1, pBitmap2, Shadow, Border : PChar);
  206. begin
  207.     ToolItems[NumTools] := New(PToolItem, Init(AParent, pType, id, X, Y, W, H,
  208.         pBitmap1, pBitmap2, Shadow, Border));
  209.  
  210.     NumTools := NumTools + 1;
  211. end;
  212.  
  213. procedure TToolBar.Paint(DC : HDC; var PS : TPaintStruct);
  214. var rcWin : TRect;
  215.     hOldPen : HPEN;
  216.     i : Integer;
  217. begin
  218.      GetClientRect( HWindow, rcWin );
  219.  
  220.     hOldPen := SelectObject(DC, GetStockObject(BLACK_PEN));
  221.     MoveTo(DC, 0, rcWin.bottom-1); LineTo(DC, rcWin.right, rcWin.bottom-1);
  222.  
  223.     SelectObject(DC, GetStockObject(WHITE_PEN));
  224.     MoveTo(DC, 0, 0); LineTo(DC, rcWin.right, 0);
  225.  
  226.     SelectObject(DC, hShadowPen);
  227.     MoveTo(DC, 0, rcWin.bottom-2); LineTo(DC, rcWin.right, rcWin.bottom-2);
  228.  
  229.     SelectObject(DC, hOldPen);
  230.  
  231.     for i := 0 to NumTools-1 do
  232.     begin
  233.          ToolItems[i]^.Show(DC, hButtonBrush, hShadowPen);
  234.     end;
  235. end;
  236.  
  237. procedure TToolBar.WMLButtonDown(var Msg: TMessage);
  238. var i : Integer;
  239.             DC : HDC;
  240. begin
  241.  
  242.     SelToolItem := -1;
  243.  
  244.     for i := 0 to NumTools-1 do
  245.     begin
  246.         if ToolItems[i]^.HitTest(Msg.LParamLo, Msg.LParamHi) then
  247.         begin
  248.             SelToolItem := i;     { Save selected tool }
  249.             ToolItems[i]^.SetState( not ToolItems[i]^.GetState );
  250.             DC := GetDC(HWindow);
  251.             ToolItems[i]^.Show(DC, hButtonBrush, hShadowPen);
  252.             ReleaseDC(HWindow, DC);
  253.  
  254.             if not ToolItems[i]^.bButton    then { Tell Toolbar the CheckBox has been set }
  255.             begin
  256.                 PostMessage(HWindow, WM_COMMAND, ToolItems[i]^.GetID, 0);
  257.                 exit;
  258.             end;
  259.         end;
  260.     end;
  261.  
  262.     bButtonDown := True;
  263.     SetCapture(HWindow);
  264. end;
  265. procedure TToolBar.WMMouseMove(var Msg: TMessage);
  266. var DC : HDC;
  267. begin
  268.     if SelToolItem >= 0 then
  269.         if  bButtonDown and ToolItems[SelToolItem]^.bButton then
  270.             if  ToolItems[SelToolItem]^.HitTest(Msg.LParamLo, Msg.LParamHi) <>
  271.                 ToolItems[SelToolItem]^.GetState then
  272.             begin
  273.                 ToolItems[SelToolItem]^.SetState( not ToolItems[SelToolItem]^.GetState );
  274.                 DC := GetDC(HWindow);
  275.                 ToolItems[SelToolItem]^.Show(DC, hButtonBrush, hShadowPen);
  276.                 ReleaseDC(HWindow, DC);
  277.             end;
  278. end;
  279. procedure TToolBar.WMLButtonUp(var Msg: TMessage);
  280. var i : Integer;
  281.             DC : HDC;
  282. begin
  283.     for i := 0 to NumTools-1 do
  284.         if ToolItems[i]^.HitTest(Msg.LParamLo, Msg.LParamHi)
  285.          and ToolItems[i]^.GetState then
  286.         begin
  287.             if ToolItems[i]^.bButton then
  288.             begin
  289.                 ToolItems[i]^.SetState( not ToolItems[i]^.GetState );
  290.                 DC := GetDC(HWindow);
  291.                 ToolItems[i]^.Show(DC, hButtonBrush, hShadowPen);
  292.                 ReleaseDC(HWindow, DC);
  293.                 { Tell Toolbar the button has been set }
  294.                 PostMessage(HWindow, WM_COMMAND,ToolItems[i]^.GetID, 0);
  295.             end;
  296.     end
  297.         else
  298.             if ToolItems[i]^.bButton and ToolItems[i]^.GetState then
  299.             begin
  300.                     ToolItems[i]^.SetState( not ToolItems[i]^.GetState );
  301.                     DC := GetDC(HWindow);
  302.                     ToolItems[i]^.Show(DC, hButtonBrush, hShadowPen);
  303.                     ReleaseDC(HWindow, DC);
  304.             end;
  305.  
  306.     bButtonDown := False;
  307.     ReleaseCapture;
  308. end;
  309.  
  310. procedure TToolBar.SetItemState(ID : Integer; bState : Boolean);
  311. var i : Integer;
  312. begin
  313.     for i := 0 to NumTools-1 do
  314.         if ToolItems[i]^.GetID = ID then
  315.         begin
  316.             ToolItems[i]^.SetState(bState);
  317.             exit;
  318.         end;
  319. end;
  320.  
  321. end.    {End of implementation }
  322.